perm filename NOTWRT.F4[MSS,LCS]5 blob
sn#107255 filedate 1974-06-15 generic text, type T, neo UTF8
00100 C******* NOTWRT - RJBX ***********
00200 SUBROUTINE NOTWRT
00300 IMPLICIT INTEGER(A-Q,S-Z)
00400 COMMON/DL/IXRX,M,AA
00500 COMMON/SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
00600 DIMENSION SU(250),RACNT(52),RDOT(7),XAC(6)
00700 REAL DIS,PWDS,CENTR,POS,STFF
00800 COMMON /STF/RSTFAC(8),RSTJC
00900 COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)
01000 COMMON/PLTR/PLT,RHT,DIS/XRN/RN(4000)/POSI/STFF(8),JJB,POS
01100 COMMON/NW/FILL(7),RNOTE(24)
01200 COMMON /NU/NUMQ(44),RNUMS(327),RACCI(32),NACCI(3)
01300 C FOR NOTE DRAWING
01400 EQUIVALENCE (JC,JQ(1)),(JD,JQ(2)),(JE,JQ(3)),(RJD,RJQ(2))
01500 1,(RJF,RJQ(4)),(JG,JQ(5)),(JH,JQ(6)),(JI,JQ(7)),(JJ,JQ(8))
01600 1,(JK,JQ(9)),(JF,JQ(4)),(RJE,RJQ(3)),(SU(1),RN(3001))
01700 1,(RJH,RJQ(6)),(RJG,RJQ(5)),(RX,JRX)
01800 DATA RACNT/4.0,1000.005,17.0,0.105, 8.0,1003.0, 7.014, 11.0
01900 1,13. ,1000. ,0.010,14.01,14. ,17. ,1001.018,7. ,13.018,27.,
02000 1 1004., 4.002, 6.004, 8.004,10.002,10., 8.102,6.102,4.
02100 1,32.0,1000.0,14.0,1007.007,7.107, 43.0,1012.01,11.006,9.003
02200 1, 7.001, 5.0, 9.002, 13.006, 15.01, 10.004, 13.009, 52.0,
02300 1 1002.008,3.003, 5.001, 8.0, 10.0, 13.001, 15.003, 16.008/
02400 DATA RDOT/1000.0, 0.103, 1.0, 1.103, 2.0, 2.103,0/
02500 1 , R5/5.0/, R66/66.0/, R72/72.0/,R18/18.0/,RSTM/14.54/
02600 1 ,XAC/9,14,18,28,33,44/
02700 C ALL DATA NUMS OVER 90 GIVE INVISIBLE VECTORS
02800 RST3=3.*RSTJC
02900 RST7=7.*RSTJC
03000 RSTX=RSTJC
03100 C FOR MINIS AT 245
03200
03300 1 CENTR=POS-R18*RSTJC+AMOD(RJD,100.0)*RST7
03400 C 'CENTR' IS VERTICAL PLACEMENT
03500 IF(JA.EQ.9)GO TO 90
03600 RMINI=RSTJC
03700 C OR SHOULD THIS ONLY BE IN NOTES, ETC? 15/9/72
03800
03900 IF(JA.EQ.101)GO TO 110
04000 RJB=JB
04100 RINV=1
04200 551 GO TO (11,20,30,241,50,242,70,80,90,11,30,80),JA
04300 IF(JA.EQ.30)GO TO 571
04400 C FOR BEAMS.
04500 90 CALL ITMSUB
04600 RETURN
04700
04800 20 IF(JE.GT.1)RJD=RJD-2
04900 CC RA=RJD
05000 RJG=RJF*10.
05100 C FOR DOTS
05200 202 CALL REST
05300 IF(JE.GT.1)GO TO 200
05400 IF(RJG.EQ.0)RETURN
05500 CC201 L=14
05600 CC IF(JE)L=19
05700 CC JB=JB+L*RSTJC
05800 CC RJD=8.+RA
05900 201 RA=14
06000 IF(JE)RA=19
06100 JB=RJB+RA*RSTJC
06200 RJD=8.+RJD
06300 JA=6
06400 JE=7
06500 C IF P6=1 THE REST IS DOTTED
06600 GO TO 1
06700 200 JE=JE-1
06800 C FOR MULTIPLE TAILS ON 16TH REST, ETC.
06900 RJD=RJD+2.
07000 CALL RJBX(4.3)
07100 GO TO 202
07200 80 CALL SLUR
07300 RETURN
07400
07500 C FOR TREMOLO SLASHES
07600 571 RJB=RJB+1
07700 RX=14.*RSTJC
07800 RJX=CENTR+RST7
07900 RJY=RJX-RX
08000 IF(MOD(JE,10).NE.0)RJY=RJX
08100 C 11 OR 21 IN P5 MAKE LEVEL BEAMS
08200 IF(JE.LT.20)GO TO 42
08300 CALL EXCH(RJX,RJY)
08400 RJB=RJB-RX+1
08500 42 RX=RJB+26*RSTJC
08600 DO 40 K=1,JF
08700 DO 41 L=0,2
08800 RA=L*RSTJC
08900 41 CALL LINX(RJB,RJX+RA,RX,RJY+RA)
09000 RJX=RJX+RST7
09100 40 RJY=RJY+RST7
09200 RETURN
09300
09400 C FOR USER-DRAWN LIBRARY OF SYMBOLS
09500 30 CALL CLEFS
09600 RETURN
09700 291 CALL RJBX(8.)
09800 IF(RINV)CENTR=CENTR-RST3
09900 C REMOVE '8' LATER
10000 CENTR=CENTR+2*RSTJC
10100
10200 29 RJX=RJB
10300 RJY=CENTR+RSTJC
10400 108 CALL RDRAW(1,7.0,RDOT,RSTJC,RJX,RJY,RSTJC)
10500 IF(JA.EQ.1.OR.RJG.GE.20.)GO TO 290
10600 RB=POS+52.*RSTJC
10700 IF(RJY.NE.RB)GO TO 6241
10800 C WHERE IS RB USED LATER?
10900 RJY=RJY-12*RSTJC
11000 GO TO 108
11100 C ABOVE FOR DOTS
11200 290 RJG=RJG-10.
11300 IF(RJG.LT.10.)GO TO 1342
11400 RJX=RJX+RSTJC*13.
11500 GO TO 108
11600
11700
11800 C FOR LEDGER LINES
11900 70 JK=JD
12000 C NOTE #
12100 170 RJW=RJB-9.*RMINI
12200 RJZ=RJB+22.*RMINI
12300 IF(JK)GO TO 71
12400 JX=JK
12500 JRX=13
12600 C********* 18/9/72
12700 GO TO 711
12800 71 JX=-JK
12900 JRX=JK*2+3
13000 711 RX=POS-18*RSTJC+RST7*JRX
13100 C********* 18/9/72
13200 IF(JF)RJZ=RJZ+2*RMINI
13300 C126 IF(PLT.EQ.-3)GO TO 1126
13400 C FOR 2-PASS PLOTTING
13500 C ******* ABOVE IS NOT USED, 15/9/72
13600 126 CALL LINX(RJW,RX,RJZ,RX)
13700 1126 IF(JX.EQ.1)GO TO 1122
13800 RX=RX+RSTJC*14.
13900 JX=JX-1
14000 GO TO 126
14100 1122 IF(JA.EQ.7)RETURN
14200 JI=-1
14300 GO TO 1121
14400
14500 C NOTES****
14600 C RACTX=ABS(AMOD(RJF,1.0))*10.
14700 11 RJF=ABS(AMOD(RJF,1.0))*10.
14800 C RJF WILL HAVE ACCENT CODE # (.7=DOT, ETC.)
14900 1011 RG=19.0
15000 KL=1
15100 IF(PLT.NE.-1)RG=14.
15200 C FOR 2-PASS PLOTTING
15300 RJAC=RJB
15400 C TO SAVE POS. OF NOTE FOR ACCENT
15500 1015 L=IABS(JD)
15600 STEM=JE/10
15700 IF(L.LT.100)GO TO 1221
15800 IF(L.LT.200)GO TO 1012
15900 KL=20
16000 IF(L.GE.300)GO TO 1014
16100 RG=24.0
16200 C FOR DIAMOND NOTES.
16300 GO TO 1013
16400 1014 RJX=RMINI*7
16500 RX=RJB+RSTM*RMINI
16600 RA=CENTR-RJX
16700 RB=CENTR+RJX
16800 CALL LINX(RJB,RA,RX,RB)
16900 CALL LINX(RJB,RB,RX,RA)
17000 IF(STEM.EQ.2)RB=RA
17100 GO TO 1013
17200 1012 RMINI=.6*RSTJC
17300 C FOR RMINI NOTES
17400 1013 JD=MOD(JD,100)
17500 CC RJD=RJD-100.
17600 RJD=AMOD(RJD,100.)
17700 CC IF(RJD.GT.160.)GO TO 1013
17800 C FOR MINI TAILS AND ACCIS. ETC.
17900 1221 JY=IABS(JF)
18000 IF(JY.LT.10.OR.JY.GE.30)GO TO 2221
18100 C P6 FOR HOMING TO RIGHT(10,30) OR LEFT(20) OF STEM(10,30=UP, 20=DOWN)
18200 C P6<0 = WHITE NOTE
18300 RQ=RSTM
18400 IF(JF)RQ=RQ+1.66
18500 C GETS WIDTH OF NOTE DISPLACEMENT
18600 IF(JY.EQ.20)RQ=-RQ
18700 RJB=RJB+RQ*RMINI
18800 2221 IF((JD.GT.1.AND.JD.LT.13).OR.JI.NE.0)GO TO 1121
18900 C ARE THERE LEDGER LINES?
19000 JK=(JD+1)/2-6
19100 IF(JK)JK=-((3-JD)/2)
19200 GO TO 170
19300 C IF JF≠0 NOTE IS FILLED IN
19400 1121 IF(JF.GE.0.AND.KL.EQ.1)GO TO 125
19500 IF(L.GE.300)GO TO 123
19600 C JUMP IF 'X' NOTE.
19700 CALL RDRAW(KL,RG,RNOTE,RMINI,RJB,CENTR,RMINI)
19800 GO TO 123
19900 125 IF(PLT)GO TO 1251
20000 CALL LINES(RJB,CENTR,3)
20100 RG=4.0
20200 GO TO 1253
20300 1251 CALL NOIR(RMINI)
20400 GO TO 123
20500
20600 1253 RG=RMINI*RG
20700 RA=RJB+RG
20800 DO 1252 K=1,7,3
20900 RB=FILL(K)*RMINI
21000 CALL LINES(RA,CENTR+RB,2)
21100 CALL LINES(RA,CENTR-RB,2)
21200 1252 RA=RA+RG
21300 C ABOVE IS NEW NOTES ROUTINE
21400
21500 123 RJE=RJE-JE
21600 C RJE=STEPS TO LEFT FOR ACCID. (.1=1 STEP)
21700 IF(STEM.EQ.0)GO TO 1242
21800 IF(L.LT.300)RB=CENTR
21900 C ≥300 IS FOR 'X' NOTES.
22000 128 JG=MOD(JG,10)
22100 RG=(JG-1)*14
22200 IF(RG)RG=0
22300 IF(RJH.GE.999)RJH=0
22400 C NO EXTEN. OF STEM?
22500 RH=RJH*RST7
22600 C STEM EXTENSIONS ARE BY NOTE #S
22700 IF(STEM.NE.2)GO TO 1280
22800 RJX=RJB
22900 C FOR STEM DOWN (=2)
23000 RG=-RG-48.
23100 RH=-RH
23200 L=20
23300 RJY=3.
23400 RJD=RJD-3.7-RJH
23500 C RJD IS USED IN SUBR. TAIL - RJH IS STEM EXTENSION.
23600 RJW=-2
23700 RA=1.
23800 GO TO 129
23900 C NEXT IS FOR STEM UP.
24000 1280 RJX=RSTM
24100 RJW=2
24200 C FOR VERT. SPACING OF MULTIPLE TAILS
24300 RJD=RJD-2+RJH
24400 C 2 ABOVE AND 3.7 BEFORE ARE BECAUSE ORIG. POS. OF TAIL DRWING IS OFF.
24500 IF(JF.NE.0.AND.JF.NE.30)RJX=16.2
24600 C FOR HALF NOTES
24700 RJX=RJX*RMINI+RJB
24800 RG=RG+48.
24900 L=10
25000 RJY=-3.
25100 RA=-1.
25200 129 RJZ=CENTR+RH+RG*RMINI
25300 IF(RMINI.NE.RSTJC)RJW=RJW*.6
25400 CALL LINX(RJX,RB,RJX,RJZ)
25500 C RB HERE IS CENTR (FOR 'X' NOTES OR NOT)
25600 227 JE=JE-L
25700 C JE HAS ACCID. # NOW
25800 IF(JG.EQ.0)GO TO 1242
25900 C JUMP IF NO TAILS
26000 127 CALL TAIL(RJX,RA,RMINI)
26100 1028 JG=JG-1
26200 IF(JG.EQ.0)GO TO 327
26300 RJD=RJD+RJW
26400 C MOVES CENTR UP OR DOWN FOR NEXT TAIL
26500 GO TO 127
26600 327 IF(JJ.EQ.0)GO TO 1242
26700 RJY=RJZ-19*RSTJC
26800 RJZ=RJZ-RSTJC*4.
26900 IF(RA.LT.0)GO TO 1327
27000 C NEXT IS FOR STEM DOWN SLASH
27100 RJY=RJZ+23*RSTJC
27200 RJZ=RJZ+RST7
27300 1327 RJX=RJX-RST7
27400 CALL LINX(RJX,RJY,RJX+17.*RSTJC,RJZ)
27500 C FOR SLASH ON GRACE NOTE TAIL
27600 1242 IF(RJG.LT.10.)GO TO 1342
27700 C FOR DOTTED NOTE-- P7>9
27800 RJX=RJAC+(24.+AMOD(RJG,1.0)*59.6)*RMINI
27900 RJY=CENTR+RSTJC
28000 IF(JY.EQ.10.OR.JY.EQ.30)RJX=RJX+RSTM
28100 C MOVES DOT TO LEFT
28200 IF(MOD(JD,2).EQ.0)GO TO 108
28300 RX=RST7
28400 IF(JY.GE.20)RX=-RX
28500 3342 RJY=RJY+RX
28600 GO TO 108
28700 C JY=30= STEM UP, INTERVAL OF SECOND.
28800 1342 RJB=RJB-RJE*59.6*RMINI
28900 C TO SPACE OUT ACCIDS.
29000 IF(RMINI.NE.RSTJC)RSTJC=.7*RSTJC
29100 C ↑↑↑↑ ↑↑↑↑↑ WAS RMINI
29200 C********* 18/9/72
29300 242 IF(JE.GE.0)GO TO 2421
29400 RINV=-RINV
29500 JE=-JE
29600 C NOW THAT 0 IS NOT USED FOR DOTS THE ABOVE 3 LINES COULD BE CHNGD
29700 C********** LAST # WAS 281?
29800 C b,#,NAT, ACC ∧, ACC >, FERMATA, DOT, REP MEAS., DASH
29900 2421 RH=14
30000 IF(JA.NE.6)GO TO 211
30100 CALL NOZERO(RJF)
30200 C RJF=SIZE FACTOR (P6)
30300 RMINI=RMINI*RJF
30400 RJF=0
30500 STEM=0
30600 C FOR MISC. ITEMS
30700 210 IF(IABS(JD).LT.100)GO TO 3241
30800 JD=MOD(JD,100)
30900 RMINI=.7*RMINI
31000 3241 JEX=-1
31100 C FOR 2 MARKS AT ONCE.
31200 1241 IF(JE.GE.11)GO TO 28
31300 GO TO (211,211,211,28,28,222,249,60,27,27),JE
31400 RETURN
31500 C ERROR TRAP (I.E. JE=0)
31600
31700 241 CALL LINES(RJB,CENTR,3)
31800 GO TO 210
31900
32000 2422 IF(RJF.EQ.0)RETURN
32100 RJB=RJAC
32200 JE=(RJF+.001)*100.
32300 1249 IF(MOD(JE,10).GT.3)GO TO 249
32400 JE=JE/10
32500 IF(JE.GT.30)GO TO 1249
32600 C WHEN P1=1, EXTRACTS ACCENT NUMBERS FROM DECIMALS IN P6.
32700 249 IF(JE.GT.30)GO TO 28
32800 IF(JE.GT.10)GO TO 246
32900 IF(JA.NE.1)GO TO 250
33000 RH=8
33100 RB=14.
33200 IF((JE.NE.7.AND.JE.NE.9).OR.MOD(JD,2).EQ.0)GO TO 244
33300 IF((STEM.LE.1.AND.JD.LT.5).OR.((STEM.EQ.2.OR.STEM.EQ.0)
33400 1 .AND.JD.GT.9))GO TO 244
33500 RB=21
33600 C PUTS ACCENT DOWN OR UP 1 SPACE. AVOIDS PUTTING DOT OR DASH ON LINE
33700 244 IF(STEM.EQ.1.OR.(STEM.EQ.0.AND.JD.LT.7))RB=-RB
33800 IF(JE.NE.6)GO TO 245
33900 IF(JD.LT.9.AND.STEM.EQ.2)GO TO 247
34000 IF(JD.GT.4.AND.STEM.EQ.1)GO TO 252
34100 245 CENTR=CENTR+RB*RSTX
34200 250 IF(JE.GT.10.OR.JE.LT.6)GO TO 247
34300 JA=6
34400 IF(JE.NE.7)GO TO 253
34500 C 7=DOT
34600 RXX=RJB
34700 RJB=RJB+6.7*RMINI
34800 C CENTERS THE DOT
34900 GO TO 29
35000 253 IF(JE.EQ.9)GO TO 271
35100 C 9=DASH
35200 251 IF(RB.LT.0)RINV=-RINV
35300 C FIX THIS!!!! FOR BOWINGS, ETC.
35400 222 CALL FERMTA(RINV)
35500 GO TO 5241
35600 252 RX=POS
35700 248 CENTR=RX
35800 GO TO 251
35900 246 IF(STEM.EQ.1)RB=70.
36000 IF(STEM.EQ.2)RB=21.
36100 C CHANGE R66 AND R72 TO NUMS WHEN RIGHT ONES ARE FOUND.
36200 GO TO 245
36300 247 RX=POS+R72*RSTJC
36400 IF(JE.EQ.6.OR.JE.EQ.26)GO TO 248
36500 C 26 IS NEW NUMB FOR FERMATA. TAKE OUT 6 EVENTUALLY.
36600 IF(JA.EQ.1.AND.JE.GT.10.AND.CENTR.LT.RX)CENTR=RX
36700 28 IF(JE.LT.30)GO TO 281
36800 JEX=MOD(JE,10)
36900 C JEX SAVES NEXT MARK.
37000 IF(JEX.LT.4)JEX=0
37100 JE=JE/10
37200 IF(JE.GT.30)RETURN
37300 C WON'T READ 415 ETC. (CORRECT=154)
37400 C DOES BOTTOM MARK FIRST, THEN TOP.
37500 CALL EXCH(JEX,JE)
37600 C PUTS UPBOW, DNBOW, ETC. ABOVE STACC., ETC.
37700 IF(JA.EQ.1)GO TO 249
37800 GO TO 1241
37900 281 X=1
38000 IF(JE.NE.4)GO TO 228
38100 X=5
38200 CALL RJBX(.5)
38300 GO TO 328
38400 228 IF(JE.GT.10)X=XAC(JE-10)
38500 C X IS POINTER IN RACNT ARRAY
38600 328 RA=RMINI
38700 C OR RSTJC?
38800 IF(RINV.LT.0.OR.(STEM.EQ.1.AND.JE.EQ.4))RA=-RA
38900 CALL RDRAW(X+1,RACNT(X),RACNT,RA,RJB,CENTR,RMINI)
39000 C PTR, WDCNT, ARRAY,Y MULT,HOR ADD,VERT ADD, X,Y,MULT
39100 C IN ARRAY, 33.012 WOULD BE X=33, Y=12. 101.123 IS X=-1, Y=-23.
39200 GO TO 5241
39300 4241 JJJ=JE
39400 JE=JEX
39500 JEX=-1
39600 IF(JA.NE.1)GO TO 7241
39700 IF(JE.GT.10)GO TO 246
39800 IF(JE.EQ.7.AND.JJJ.NE.9)GO TO 249
39900 7241 RXX=RH*RMINI
40000 IF(STEM.EQ.1)RXX=-RXX
40100 CENTR=CENTR+RXX
40200 IF(JE.EQ.26)JE=6
40300 C TEMPORARY?? FIX
40400 GO TO 1241
40500 C >=5, ∧=4
40600 27 RJB=JB
40700 C DASHES
40800 271 CALL LINX(RJB,CENTR,RJB+RSTJC*14.,CENTR)
40900 5241 IF(JEX.GT.0)GO TO 4241
41000 C JEX IS FOR DOUBLE MARKS. (WHAT ABOUT DOT POSITION.)
41100 RETURN
41200 6241 RJB=RXX
41300 C RESET RJB AFTER A DOT.
41400 GO TO 5241
41500 211 IF(JE.EQ.0)GO TO 2422
41600 IF(JE.GT.3)GO TO 222
41700 C FOR 2-PASS PLOTTING (-2=THIN LINES, -3=HEAVY LINES)
41800 X=NACCI(JE)
41900 CALL RDRAW(X+1,RACCI(X),RACCI,RMINI,RJB,CENTR,RMINI)
42000 GO TO 2422
42100
42200 500 RJB=RJB-RST3
42300 JJB=JJB-RSTJC*13.
42400 C ADJUSTS POS. OF #S
42500 JE=JE-1
42600 GO TO 222
42700 C NUMS- 5, POS, STF, NT#, P5=SZ(DECI'S), P6=NUM(>0=LETTERS),P7=1=BDR40
42800 50 IF(JG.NE.0.AND.PLT)GO TO 52
42900 RDIS=RJE
43000 JJJ=JF
43100 CALL NOZERO(RDIS)
43200 PUNCT=0
43300 IF(JJJ.LT.44)GO TO 51
43400 PUNCT=JJJ
43500 IF(JJJ.EQ.44)JJJ=38
43600 IF(JJJ.GE.45)JJJ=36
43700 IF(JF.NE.46)GO TO 51
43800 RXX=4
43900 CALL RJBX(-RXX)
44000 RX=16
44100 CENTR=CENTR+RX*RSTJC
44200 51 RX=RDIS*RSTJC
44300 451 X=NUMQ(JJJ+1)
44400 C X=END # OF ITEM
44500 C X+1=1ST PART OF ITEM
44600 CALL RDRAW(X+1,RNUMS(X),RNUMS,RX,RJB,CENTR+RST3,RX)
44700 IF(PUNCT.EQ.0)GO TO 151
44800 IF(PUNCT.NE.46)GO TO 351
44900 CALL RJBX(2.*RXX)
45000 C FOR "
45100 651 PUNCT=0
45200 GO TO 451
45300 351 RXX=11
45400 C FOR : AND ;
45500 CENTR=CENTR+RXX*RSTJC
45600 JJJ=38
45700 GO TO 651
45800 151 IF(JA.EQ.101)GO TO 1005
45900 RETURN
46000 52 CALL MAKNUM(RJF)
46100 RETURN
46200
46300 110 JC=RJB
46400 IF(JC.NE.99)GO TO 1008
46500 CALL HYDPOG(2)
46600 RETURN
46700 1008 JF=0
46800 JE=0
46900 RSTJC=1.
47000 C SETS UP SCALE LINES.
47100 RJC=STFF(JC+4)+60
47200 RJ=RJC+60
47300 CENTR=RJC+74
47400 CALL DPYSET(2,SU,250)
47500 CALL DPYBRT(1)
47600 1001 POS=RJC+64
47700 DO 1002 MX=10,200,10
47800 RA=RHORZ(FLOAT(MX))
47900 RJB=RA-58
48000 IF(MX.GT.10)GO TO 50
48100 1005 IF(RJE.NE.0)GO TO 1007
48200 C JUMP FOR STAFF NUMBERS
48300 CALL LINX(RA,RJC,RA,RJ)
48400 JF=JF+1
48500 1002 IF(JF.EQ.10)JF=0
48600 CALL LINES(-596.0,RJ,2)
48700 CALL LINES(-596.0,RJC,2)
48800 RJE=1.5
48900 C NEXT SETS UP STAFF NUMBERS
49000 RJB=-620.
49100 DO 1007 K=-3,4
49200 CENTR=STFF(K+4)+21.
49300 JF=IABS(K)
49400 GO TO 50
49500 1007 CONTINUE
49600 CALL DPYOUT(2)
49700 CALL SETPOG(1)
49800 RETURN
49900
50000 C FOR 1 OR 2 BAR REP SIGNS.
50100 60 CALL BREP(RJB,RSTJC)
50200 END
50300
50400 SUBROUTINE RJBX(R)
50500 COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)/STF/RSTFAC(8),RSTJC
50600 RJB=RJB+R*RSTJC
50700 END